library(ggplot2)
library(ggpubr)
library(CDM)
library(boot)
library(tidyverse)
library(dummy)
library(stringi)
library(stringr)

rm(list = ls())

x_pre <- read_csv("data\\OUTPUT.csv")
Parsed with column specification:
cols(
  .default = col_character(),
  SubjectID = col_double(),
  `Auto Score 1` = col_double(),
  `Auto Score 2` = col_double(),
  `Auto Score 3` = col_double(),
  `Auto Score 4` = col_double(),
  `Auto Score 5` = col_double(),
  `Auto Score 6` = col_double(),
  `Auto Score 7` = col_double(),
  `Auto Score 8` = col_double(),
  `Auto Score 9` = col_double(),
  `Auto Score 10` = col_double(),
  `Auto Score 11` = col_double(),
  `Auto Score 12` = col_double(),
  `Auto Score 13` = col_double(),
  `Auto Score 14` = col_double(),
  `Auto Score 15` = col_double(),
  `Auto Score 16` = col_double(),
  `Auto Score 17` = col_double(),
  `Auto Score 18` = col_double(),
  `Auto Score 19` = col_double()
  # ... with 34 more columns
)
See spec(...) for full column specifications.
Q <- read_csv("data\\Q.csv")
Parsed with column specification:
cols(
  .default = col_double()
)
See spec(...) for full column specifications.
#glimpse(x_pre)

head(x_pre)
NA

x.gather <-x_pre %>% gather(key = "key", value = "value", -File, -SubjectID)
x.gather 
x.questions <- 
  
  x.gather %>% filter(str_detect(key, "Question")) 

x.questions.dist <- x.questions %>% distinct(value) %>% drop_na() %>%  mutate(Q_UNIQUE_ID = row_number())

x.questions.dist %>% write_csv("data\\Q_distinct_id.csv")
x.questions.dist 
NA

x.answers <- 
  
  x.gather %>% filter(!str_detect(key, "Question"))

x.answers
x.questions %>% distinct(key)
x.answers %>% distinct(key)

x.questions.id <- x.questions %>% inner_join(x.questions.dist) %>% mutate(Q_UNIQUE_ID  = factor(Q_UNIQUE_ID)) 
Joining, by = "value"
x.questions.id
#x.questions.id %>% mutate(var = 1) %>% select(-key)  %>% spread(key = "Q_UNIQUE_ID", value = "var")

x.questions.id[c(2596, 9789),] 
NA

x.questions.id[c(1330, 3101),] 
NA

x.questions.id[c(8679, 11543),] 
NA

x.questions.id[c(1871, 6917),] 
NA

x.questions.id[c(1458, 5003),] 
NA
x.questions.id[c(3221, 6926),] 

x.questions.id.filterd <- x.questions.id %>% anti_join(x.questions.id %>% group_by(File, SubjectID, value) %>% summarise(cnt = n(), question_number = paste(key, collapse = ",")) %>% filter(cnt > 1) %>% ungroup(), by = "value")


x.questions.id.filterd
NA

We have the correct Questions. Now we need to add marks of answers against the questions.


X.pre <- x.questions.id.filterd %>% mutate(id = str_split(key, " ", simplify = TRUE)[,2]) %>% 
  inner_join(
    
    x.answers %>% mutate(id = str_split(key, " ", simplify = TRUE)[,3]), by = c("File", "SubjectID", "id")
    
    ) %>% mutate(value.y = as.integer(value.y))

write_csv(X.pre, "X_Pre.csv")
X.pre


X<- X.pre %>% select(-key.x, -key.y, -value.x, -id ) %>%
  mutate(Q_UNIQUE_ID = as.integer(Q_UNIQUE_ID)) %>%
  semi_join(
  
  Q %>% distinct(Q_UNIQUE_ID)
  
) %>% spread(key = "Q_UNIQUE_ID", value = "value.y")  
Joining, by = "Q_UNIQUE_ID"
  

write_csv(X, "X.csv")
X

Let’s run some test to verify X


X %>% select(-File, -SubjectID) %>% summarise_all(sum, na.rm = TRUE)
NA

X %>% gather(key = "QuestionID", value = "Score", -File, -SubjectID)
NA

X %>% gather(key = "QuestionID", value = "Score", -File, -SubjectID) %>% filter(File == "Exam1Trial1") %>% mutate(Score = fct_explicit_na(as.character(Score))) %>% group_by(SubjectID, Score) %>% tally() %>%
  
  ggplot() + 
  aes(x=SubjectID, y=n, fill = Score) + 
  geom_col(position = position_dodge2()) + facet_wrap(Score~., scales = "free")

NA
NA

X %>% gather(key = "QuestionID", value = "Score", -File, -SubjectID) %>% filter(File == "Exam1Trial1") %>% mutate(Score = fct_explicit_na(as.character(Score))) %>% filter(Score != "(Missing)") %>% group_by(SubjectID, Score) %>% tally() %>%
  
  ggplot() + 
  aes(x=SubjectID, y=n, fill = Score) + 
  geom_col(position = position_stack())

NA
NA

How many times a question is asked


X %>% gather(key = "QuestionID", value = "Score", -File, -SubjectID) %>% filter(File == "Exam1Trial1") %>% mutate(Score = fct_explicit_na(as.character(Score))) %>% filter(Score != "(Missing)") %>% group_by(QuestionID, Score) %>% tally() %>% filter(n > 4) %>%
  
  ggplot() + 
  aes(x=QuestionID, y=n, fill = Score) + 
  geom_col(position = position_stack()) + 
  stat_mean() + facet_wrap(Score~.) + coord_flip()

NA
NA

X %>% gather(key = "QuestionID", value = "Score", -File, -SubjectID) %>% filter(File == "Exam1Trial1") %>% mutate(Score = fct_explicit_na(as.character(Score))) %>% group_by(SubjectID, Score) %>% tally() %>% filter(n > 4) %>% ungroup() %>%
  
  ggplot() + 
  aes(x=SubjectID, y=n, fill = Score) + 
  geom_col(position = position_stack()) + 
  stat_summary(fun.y = min, geom = "line") + 
  stat_mean() + facet_grid(Score~., scales = "free") 

NA
NA

Filter questions asked in Exam I


library(janitor)
X %>% filter(File == "Exam1Trial1") %>% remove_empty(.,which = "cols")
NA

#Quantify Sparsity



X %>% filter(File == "Exam1Trial1") %>% remove_empty(.,which = "cols") %>% 
  gather(key = "QuestionID", value = "Scores", -File, -SubjectID) %>% 
  group_by(File, SubjectID) %>%
  summarise(total_na = sum(is.na(Scores)), total = n(), total_attempted = total - total_na) %>% 
  
  ggplot() + aes(x=SubjectID, y = total_attempted) + geom_col() + geom_hline(aes(yintercept = min(total_attempted))) + geom_hline(aes(yintercept = max(total_attempted)))

NA
NA

#Question attempts for Exam1Trial1



X %>% filter(File == "Exam1Trial1") %>% remove_empty(.,which = "cols") %>% 
  gather(key = "QuestionID", value = "Scores", -File, -SubjectID) %>% 
  group_by(File, QuestionID) %>%
  summarise(total_na = sum(is.na(Scores)), total = n(), total_attempted = total - total_na) %>% 
  
  ggplot() + aes(x=QuestionID, y = total_attempted) + geom_col() + 
  geom_hline(aes(yintercept = min(total_attempted))) + geom_hline(aes(yintercept = max(total_attempted))) + 
  coord_flip()

NA
NA

#Question attempts for All Trials



X %>%  remove_empty(.,which = "cols") %>% 
  gather(key = "QuestionID", value = "Scores", -File, -SubjectID) %>% 
  group_by(File, QuestionID) %>%
  summarise(total_na = sum(is.na(Scores)), total = n(), total_attempted = total - total_na) %>% 
  
  ggplot() + aes(x=QuestionID, y = total_attempted) + geom_col() + 
  geom_hline(aes(yintercept = min(total_attempted))) + geom_hline(aes(yintercept = max(total_attempted))) + 
   facet_grid(.~File, scales = "free")

NA
NA

Questions with good attempt count



question_attempted <- X %>% remove_empty(.,which = "cols") %>% 
  gather(key = "QuestionID", value = "Scores", -File, -SubjectID) %>% 
  group_by(File, QuestionID) %>%
  summarise(total_na = sum(is.na(Scores)), total = n(), total_attempted = total - total_na)

question_attempted <- question_attempted %>% filter(total_attempted >= 8)

question_attempted

#%>% filter(QuestionID == "103")

Filtering out questions with lesser attempts


X_filtered <- X %>% remove_empty(.,which = "cols") %>% 
  gather(key = "QuestionID", value = "Scores", -File, -SubjectID) %>% semi_join(question_attempted, by = c("File", "QuestionID")) %>% 
  spread(key = "QuestionID", value = "Scores")

X_filtered

Take away questions answered less that 5 times per exam

X %>% remove_empty(.,which = "cols") %>% write_csv("data\\X.csv")

X_filtered %>% remove_empty(.,which = "cols") %>% write_csv("data\\X_filtered.csv")

Write CSVs seperate for each trial to avoid having columns for those questions that were not asked in a trial. This will help to show the true picture of sparsity.


fn.clean <- function (df) {
  return(df %>% remove_empty(.,which = "cols"))
  
}


X.individual.list <- X %>% 
nest(-File) %>% 
  mutate(data_clean = map(data, fn.clean))

X.individual.list
# A tibble: 8 x 3
  File        data                data_clean         
  <chr>       <list>              <list>             
1 Exam1Trial1 <tibble [74 x 940]> <tibble [74 x 287]>
2 Exam1Trial2 <tibble [57 x 940]> <tibble [57 x 278]>
3 Exam2Trial1 <tibble [66 x 940]> <tibble [66 x 236]>
4 Exam2Trial2 <tibble [67 x 940]> <tibble [67 x 237]>
5 Exam3Trial1 <tibble [47 x 940]> <tibble [47 x 178]>
6 Exam3Trial2 <tibble [78 x 940]> <tibble [78 x 179]>
7 Exam4Trial1 <tibble [64 x 940]> <tibble [64 x 239]>
8 Exam4Trial2 <tibble [72 x 940]> <tibble [72 x 239]>

fn.write <- function(key, data) {
  
  print(data)
  data %>% write_csv(paste0("data\\",key,".csv"))
  
}

walk2(X.individual.list$File, X.individual.list$data_clean, fn.write)
NA
NA

X %>% filter(File == "Exam1Trial1") %>% remove_empty(.,which = "cols")
NA

X %>% filter(File == "Exam1Trial2") %>% remove_empty(.,which = "cols")
NA

X %>% filter(File == "Exam2Trial1") %>% remove_empty(.,which = "cols") %>%
  gather(key="Questions", value = "Answers", -File, -SubjectID) %>% 
  mutate(Answers = fct_explicit_na(as.character (Answers))) %>%
  
  ggplot() + aes(x = Questions, fill = Answers) + geom_bar(position = position_dodge2()) + facet_wrap(Answers ~. , scales = "free")


X %>% filter(File == "Exam2Trial1") %>% remove_empty(.,which = "cols") %>%
  gather(key="Questions", value = "Answers", -File, -SubjectID) %>% 
  mutate(Answers = fct_explicit_na(as.character (Answers))) %>%
  
  ggplot() + aes(x = Answers) + geom_bar(position = position_dodge2()) + facet_wrap(Answers ~. , scales = "free")

Merge with Q


Q <- read_csv("data\\Q.csv")
Parsed with column specification:
cols(
  .default = col_double()
)
See spec(...) for full column specifications.
Q
NA

fn.skills <- function (df) {
  
  df <- df %>% remove_empty(.,which = "cols") %>%
  gather(key = "Q_UNIQUE_ID", value = "Score", -SubjectID) %>%
  mutate(Q_UNIQUE_ID = as.integer(Q_UNIQUE_ID)) %>% distinct(Q_UNIQUE_ID) %>%
  
  inner_join(
    Q
    
  ) %>% remove_empty(.,which = "cols")
  
  return(df)
  
}


X.Q <- X.individual.list %>% 
  mutate(data_Q_skills = map(data_clean, fn.skills))
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
X.Q 
# A tibble: 8 x 4
  File        data                data_clean          data_Q_skills      
  <chr>       <list>              <list>              <list>             
1 Exam1Trial1 <tibble [74 x 940]> <tibble [74 x 287]> <tibble [286 x 25]>
2 Exam1Trial2 <tibble [57 x 940]> <tibble [57 x 278]> <tibble [277 x 25]>
3 Exam2Trial1 <tibble [66 x 940]> <tibble [66 x 236]> <tibble [235 x 17]>
4 Exam2Trial2 <tibble [67 x 940]> <tibble [67 x 237]> <tibble [236 x 17]>
5 Exam3Trial1 <tibble [47 x 940]> <tibble [47 x 178]> <tibble [177 x 14]>
6 Exam3Trial2 <tibble [78 x 940]> <tibble [78 x 179]> <tibble [178 x 14]>
7 Exam4Trial1 <tibble [64 x 940]> <tibble [64 x 239]> <tibble [238 x 14]>
8 Exam4Trial2 <tibble [72 x 940]> <tibble [72 x 239]> <tibble [238 x 14]>
#X %>% filter(File == "Exam1Trial1") %>% remove_empty(.,which = "cols") %>%
#  gather(key = "Q_UNIQUE_ID", value = "Score", -File, -SubjectID) %>%
#  mutate(Q_UNIQUE_ID = as.integer(Q_UNIQUE_ID)) %>% distinct(Q_UNIQUE_ID) %>%
#  
#  inner_join(
#    Q
#    
#  ) %>% remove_empty(.,which = "cols")
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQoNCg0KYGBge3J9DQoNCmxpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkoZ2dwdWJyKQ0KbGlicmFyeShDRE0pDQpsaWJyYXJ5KGJvb3QpDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmxpYnJhcnkoZHVtbXkpDQpsaWJyYXJ5KHN0cmluZ2kpDQpsaWJyYXJ5KHN0cmluZ3IpDQoNCg0KYGBgDQoNCg0KYGBge3J9DQoNCnJtKGxpc3QgPSBscygpKQ0KDQp4X3ByZSA8LSByZWFkX2NzdigiZGF0YVxcT1VUUFVULmNzdiIpDQpRIDwtIHJlYWRfY3N2KCJkYXRhXFxRLmNzdiIpDQoNCiNnbGltcHNlKHhfcHJlKQ0KDQpgYGANCg0KDQpgYGB7cn0NCg0KaGVhZCh4X3ByZSkNCg0KYGBgDQoNCmBgYHtyfQ0KDQp4LmdhdGhlciA8LXhfcHJlICU+JSBnYXRoZXIoa2V5ID0gImtleSIsIHZhbHVlID0gInZhbHVlIiwgLUZpbGUsIC1TdWJqZWN0SUQpDQp4LmdhdGhlciANCmBgYA0KDQoNCg0KYGBge3J9DQp4LnF1ZXN0aW9ucyA8LSANCiAgDQogIHguZ2F0aGVyICU+JSBmaWx0ZXIoc3RyX2RldGVjdChrZXksICJRdWVzdGlvbiIpKSANCg0KeC5xdWVzdGlvbnMuZGlzdCA8LSB4LnF1ZXN0aW9ucyAlPiUgZGlzdGluY3QodmFsdWUpICU+JSBkcm9wX25hKCkgJT4lICBtdXRhdGUoUV9VTklRVUVfSUQgPSByb3dfbnVtYmVyKCkpDQoNCngucXVlc3Rpb25zLmRpc3QgJT4lIHdyaXRlX2NzdigiZGF0YVxcUV9kaXN0aW5jdF9pZC5jc3YiKQ0KeC5xdWVzdGlvbnMuZGlzdCANCg0KYGBgDQoNCmBgYHtyfQ0KDQp4LmFuc3dlcnMgPC0gDQogIA0KICB4LmdhdGhlciAlPiUgZmlsdGVyKCFzdHJfZGV0ZWN0KGtleSwgIlF1ZXN0aW9uIikpDQoNCnguYW5zd2Vycw0KYGBgDQoNCg0KYGBge3J9DQp4LnF1ZXN0aW9ucyAlPiUgZGlzdGluY3Qoa2V5KQ0KYGBgDQoNCg0KYGBge3J9DQp4LmFuc3dlcnMgJT4lIGRpc3RpbmN0KGtleSkNCmBgYA0KDQoNCmBgYHtyfQ0KDQp4LnF1ZXN0aW9ucy5pZCA8LSB4LnF1ZXN0aW9ucyAlPiUgaW5uZXJfam9pbih4LnF1ZXN0aW9ucy5kaXN0KSAlPiUgbXV0YXRlKFFfVU5JUVVFX0lEICA9IGZhY3RvcihRX1VOSVFVRV9JRCkpIA0KDQp4LnF1ZXN0aW9ucy5pZA0KYGBgDQoNCg0KYGBge3J9DQojeC5xdWVzdGlvbnMuaWQgJT4lIG11dGF0ZSh2YXIgPSAxKSAlPiUgc2VsZWN0KC1rZXkpICAlPiUgc3ByZWFkKGtleSA9ICJRX1VOSVFVRV9JRCIsIHZhbHVlID0gInZhciIpDQpgYGANCg0KDQpgYGB7cn0NCg0KeC5xdWVzdGlvbnMuaWRbYygyNTk2LCA5Nzg5KSxdIA0KDQpgYGANCg0KDQoNCmBgYHtyfQ0KDQp4LnF1ZXN0aW9ucy5pZFtjKDEzMzAsIDMxMDEpLF0gDQoNCmBgYA0KDQoNCg0KYGBge3J9DQoNCngucXVlc3Rpb25zLmlkW2MoODY3OSwgMTE1NDMpLF0gDQoNCmBgYA0KDQpgYGB7cn0NCg0KeC5xdWVzdGlvbnMuaWRbYygxODcxLCA2OTE3KSxdIA0KDQpgYGANCg0KYGBge3J9DQoNCngucXVlc3Rpb25zLmlkW2MoMTQ1OCwgNTAwMyksXSANCg0KYGBgDQoNCmBgYHtyfQ0KeC5xdWVzdGlvbnMuaWRbYygzMjIxLCA2OTI2KSxdIA0KYGBgDQoNCmBgYHtyfQ0KDQp4LnF1ZXN0aW9ucy5pZC5maWx0ZXJkIDwtIHgucXVlc3Rpb25zLmlkICU+JSBhbnRpX2pvaW4oeC5xdWVzdGlvbnMuaWQgJT4lIGdyb3VwX2J5KEZpbGUsIFN1YmplY3RJRCwgdmFsdWUpICU+JSBzdW1tYXJpc2UoY250ID0gbigpLCBxdWVzdGlvbl9udW1iZXIgPSBwYXN0ZShrZXksIGNvbGxhcHNlID0gIiwiKSkgJT4lIGZpbHRlcihjbnQgPiAxKSAlPiUgdW5ncm91cCgpLCBieSA9ICJ2YWx1ZSIpDQoNCg0KeC5xdWVzdGlvbnMuaWQuZmlsdGVyZA0KDQpgYGANCg0KDQpXZSBoYXZlIHRoZSBjb3JyZWN0IFF1ZXN0aW9ucy4gTm93IHdlIG5lZWQgdG8gYWRkIG1hcmtzIG9mIGFuc3dlcnMgYWdhaW5zdCB0aGUgcXVlc3Rpb25zLg0KYGBge3J9DQoNClgucHJlIDwtIHgucXVlc3Rpb25zLmlkLmZpbHRlcmQgJT4lIG11dGF0ZShpZCA9IHN0cl9zcGxpdChrZXksICIgIiwgc2ltcGxpZnkgPSBUUlVFKVssMl0pICU+JSANCiAgaW5uZXJfam9pbigNCiAgICANCiAgICB4LmFuc3dlcnMgJT4lIG11dGF0ZShpZCA9IHN0cl9zcGxpdChrZXksICIgIiwgc2ltcGxpZnkgPSBUUlVFKVssM10pLCBieSA9IGMoIkZpbGUiLCAiU3ViamVjdElEIiwgImlkIikNCiAgICANCiAgICApICU+JSBtdXRhdGUodmFsdWUueSA9IGFzLmludGVnZXIodmFsdWUueSkpDQoNCndyaXRlX2NzdihYLnByZSwgIlhfUHJlLmNzdiIpDQpYLnByZQ0KYGBgDQoNCmBgYHtyfQ0KDQoNClg8LSBYLnByZSAlPiUgc2VsZWN0KC1rZXkueCwgLWtleS55LCAtdmFsdWUueCwgLWlkICkgJT4lDQogIG11dGF0ZShRX1VOSVFVRV9JRCA9IGFzLmludGVnZXIoUV9VTklRVUVfSUQpKSAlPiUNCiAgc2VtaV9qb2luKA0KICANCiAgUSAlPiUgZGlzdGluY3QoUV9VTklRVUVfSUQpDQogIA0KKSAlPiUgc3ByZWFkKGtleSA9ICJRX1VOSVFVRV9JRCIsIHZhbHVlID0gInZhbHVlLnkiKSAgDQogIA0KDQp3cml0ZV9jc3YoWCwgIlguY3N2IikNClgNCmBgYA0KDQpMZXQncyBydW4gc29tZSB0ZXN0IHRvIHZlcmlmeSBYDQpgYGB7cn0NCg0KWCAlPiUgc2VsZWN0KC1GaWxlLCAtU3ViamVjdElEKSAlPiUgc3VtbWFyaXNlX2FsbChzdW0sIG5hLnJtID0gVFJVRSkNCg0KYGBgDQoNCmBgYHtyfQ0KDQpYICU+JSBnYXRoZXIoa2V5ID0gIlF1ZXN0aW9uSUQiLCB2YWx1ZSA9ICJTY29yZSIsIC1GaWxlLCAtU3ViamVjdElEKQ0KDQpgYGANCg0KYGBge3J9DQoNClggJT4lIGdhdGhlcihrZXkgPSAiUXVlc3Rpb25JRCIsIHZhbHVlID0gIlNjb3JlIiwgLUZpbGUsIC1TdWJqZWN0SUQpICU+JSBmaWx0ZXIoRmlsZSA9PSAiRXhhbTFUcmlhbDEiKSAlPiUgbXV0YXRlKFNjb3JlID0gZmN0X2V4cGxpY2l0X25hKGFzLmNoYXJhY3RlcihTY29yZSkpKSAlPiUgZ3JvdXBfYnkoU3ViamVjdElELCBTY29yZSkgJT4lIHRhbGx5KCkgJT4lDQogIA0KICBnZ3Bsb3QoKSArIA0KICBhZXMoeD1TdWJqZWN0SUQsIHk9biwgZmlsbCA9IFNjb3JlKSArIA0KICBnZW9tX2NvbChwb3NpdGlvbiA9IHBvc2l0aW9uX2RvZGdlMigpKSArIGZhY2V0X3dyYXAoU2NvcmV+Liwgc2NhbGVzID0gImZyZWUiKQ0KICANCg0KYGBgDQoNCmBgYHtyfQ0KDQpYICU+JSBnYXRoZXIoa2V5ID0gIlF1ZXN0aW9uSUQiLCB2YWx1ZSA9ICJTY29yZSIsIC1GaWxlLCAtU3ViamVjdElEKSAlPiUgZmlsdGVyKEZpbGUgPT0gIkV4YW0xVHJpYWwxIikgJT4lIG11dGF0ZShTY29yZSA9IGZjdF9leHBsaWNpdF9uYShhcy5jaGFyYWN0ZXIoU2NvcmUpKSkgJT4lIGZpbHRlcihTY29yZSAhPSAiKE1pc3NpbmcpIikgJT4lIGdyb3VwX2J5KFN1YmplY3RJRCwgU2NvcmUpICU+JSB0YWxseSgpICU+JQ0KICANCiAgZ2dwbG90KCkgKyANCiAgYWVzKHg9U3ViamVjdElELCB5PW4sIGZpbGwgPSBTY29yZSkgKyANCiAgZ2VvbV9jb2wocG9zaXRpb24gPSBwb3NpdGlvbl9zdGFjaygpKQ0KICANCg0KYGBgDQoNCiMgSG93IG1hbnkgdGltZXMgYSBxdWVzdGlvbiBpcyBhc2tlZA0KYGBge3J9DQoNClggJT4lIGdhdGhlcihrZXkgPSAiUXVlc3Rpb25JRCIsIHZhbHVlID0gIlNjb3JlIiwgLUZpbGUsIC1TdWJqZWN0SUQpICU+JSBmaWx0ZXIoRmlsZSA9PSAiRXhhbTFUcmlhbDEiKSAlPiUgbXV0YXRlKFNjb3JlID0gZmN0X2V4cGxpY2l0X25hKGFzLmNoYXJhY3RlcihTY29yZSkpKSAlPiUgZmlsdGVyKFNjb3JlICE9ICIoTWlzc2luZykiKSAlPiUgZ3JvdXBfYnkoUXVlc3Rpb25JRCwgU2NvcmUpICU+JSB0YWxseSgpICU+JSBmaWx0ZXIobiA+IDQpICU+JQ0KICANCiAgZ2dwbG90KCkgKyANCiAgYWVzKHg9UXVlc3Rpb25JRCwgeT1uLCBmaWxsID0gU2NvcmUpICsgDQogIGdlb21fY29sKHBvc2l0aW9uID0gcG9zaXRpb25fc3RhY2soKSkgKyANCiAgc3RhdF9tZWFuKCkgKyBmYWNldF93cmFwKFNjb3Jlfi4pICsgY29vcmRfZmxpcCgpDQogIA0KDQpgYGANCg0KYGBge3J9DQoNClggJT4lIGdhdGhlcihrZXkgPSAiUXVlc3Rpb25JRCIsIHZhbHVlID0gIlNjb3JlIiwgLUZpbGUsIC1TdWJqZWN0SUQpICU+JSBmaWx0ZXIoRmlsZSA9PSAiRXhhbTFUcmlhbDEiKSAlPiUgbXV0YXRlKFNjb3JlID0gZmN0X2V4cGxpY2l0X25hKGFzLmNoYXJhY3RlcihTY29yZSkpKSAlPiUgZ3JvdXBfYnkoU3ViamVjdElELCBTY29yZSkgJT4lIHRhbGx5KCkgJT4lIGZpbHRlcihuID4gNCkgJT4lIHVuZ3JvdXAoKSAlPiUNCiAgDQogIGdncGxvdCgpICsgDQogIGFlcyh4PVN1YmplY3RJRCwgeT1uLCBmaWxsID0gU2NvcmUpICsgDQogIGdlb21fY29sKHBvc2l0aW9uID0gcG9zaXRpb25fc3RhY2soKSkgKyANCiAgc3RhdF9zdW1tYXJ5KGZ1bi55ID0gbWluLCBnZW9tID0gImxpbmUiKSArIA0KICBzdGF0X21lYW4oKSArIGZhY2V0X2dyaWQoU2NvcmV+Liwgc2NhbGVzID0gImZyZWUiKSANCiAgDQoNCmBgYA0KDQojIEZpbHRlciBxdWVzdGlvbnMgYXNrZWQgaW4gRXhhbSBJDQoNCmBgYHtyfQ0KDQpsaWJyYXJ5KGphbml0b3IpDQpYICU+JSBmaWx0ZXIoRmlsZSA9PSAiRXhhbTFUcmlhbDEiKSAlPiUgcmVtb3ZlX2VtcHR5KC4sd2hpY2ggPSAiY29scyIpDQoNCmBgYA0KDQojUXVhbnRpZnkgU3BhcnNpdHkNCmBgYHtyfQ0KDQoNClggJT4lIGZpbHRlcihGaWxlID09ICJFeGFtMVRyaWFsMSIpICU+JSByZW1vdmVfZW1wdHkoLix3aGljaCA9ICJjb2xzIikgJT4lIA0KICBnYXRoZXIoa2V5ID0gIlF1ZXN0aW9uSUQiLCB2YWx1ZSA9ICJTY29yZXMiLCAtRmlsZSwgLVN1YmplY3RJRCkgJT4lIA0KICBncm91cF9ieShGaWxlLCBTdWJqZWN0SUQpICU+JQ0KICBzdW1tYXJpc2UodG90YWxfbmEgPSBzdW0oaXMubmEoU2NvcmVzKSksIHRvdGFsID0gbigpLCB0b3RhbF9hdHRlbXB0ZWQgPSB0b3RhbCAtIHRvdGFsX25hKSAlPiUgDQogIA0KICBnZ3Bsb3QoKSArIGFlcyh4PVN1YmplY3RJRCwgeSA9IHRvdGFsX2F0dGVtcHRlZCkgKyBnZW9tX2NvbCgpICsgZ2VvbV9obGluZShhZXMoeWludGVyY2VwdCA9IG1pbih0b3RhbF9hdHRlbXB0ZWQpKSkgKyBnZW9tX2hsaW5lKGFlcyh5aW50ZXJjZXB0ID0gbWF4KHRvdGFsX2F0dGVtcHRlZCkpKQ0KDQoNCmBgYA0KDQojUXVlc3Rpb24gYXR0ZW1wdHMgZm9yIEV4YW0xVHJpYWwxDQoNCmBgYHtyfQ0KDQoNClggJT4lIGZpbHRlcihGaWxlID09ICJFeGFtMVRyaWFsMSIpICU+JSByZW1vdmVfZW1wdHkoLix3aGljaCA9ICJjb2xzIikgJT4lIA0KICBnYXRoZXIoa2V5ID0gIlF1ZXN0aW9uSUQiLCB2YWx1ZSA9ICJTY29yZXMiLCAtRmlsZSwgLVN1YmplY3RJRCkgJT4lIA0KICBncm91cF9ieShGaWxlLCBRdWVzdGlvbklEKSAlPiUNCiAgc3VtbWFyaXNlKHRvdGFsX25hID0gc3VtKGlzLm5hKFNjb3JlcykpLCB0b3RhbCA9IG4oKSwgdG90YWxfYXR0ZW1wdGVkID0gdG90YWwgLSB0b3RhbF9uYSkgJT4lIA0KICANCiAgZ2dwbG90KCkgKyBhZXMoeD1RdWVzdGlvbklELCB5ID0gdG90YWxfYXR0ZW1wdGVkKSArIGdlb21fY29sKCkgKyANCiAgZ2VvbV9obGluZShhZXMoeWludGVyY2VwdCA9IG1pbih0b3RhbF9hdHRlbXB0ZWQpKSkgKyBnZW9tX2hsaW5lKGFlcyh5aW50ZXJjZXB0ID0gbWF4KHRvdGFsX2F0dGVtcHRlZCkpKSArIA0KICBjb29yZF9mbGlwKCkNCg0KDQpgYGANCg0KI1F1ZXN0aW9uIGF0dGVtcHRzIGZvciBBbGwgVHJpYWxzDQoNCmBgYHtyfQ0KDQoNClggJT4lICByZW1vdmVfZW1wdHkoLix3aGljaCA9ICJjb2xzIikgJT4lIA0KICBnYXRoZXIoa2V5ID0gIlF1ZXN0aW9uSUQiLCB2YWx1ZSA9ICJTY29yZXMiLCAtRmlsZSwgLVN1YmplY3RJRCkgJT4lIA0KICBncm91cF9ieShGaWxlLCBRdWVzdGlvbklEKSAlPiUNCiAgc3VtbWFyaXNlKHRvdGFsX25hID0gc3VtKGlzLm5hKFNjb3JlcykpLCB0b3RhbCA9IG4oKSwgdG90YWxfYXR0ZW1wdGVkID0gdG90YWwgLSB0b3RhbF9uYSkgJT4lIA0KICANCiAgZ2dwbG90KCkgKyBhZXMoeD1RdWVzdGlvbklELCB5ID0gdG90YWxfYXR0ZW1wdGVkKSArIGdlb21fY29sKCkgKyANCiAgZ2VvbV9obGluZShhZXMoeWludGVyY2VwdCA9IG1pbih0b3RhbF9hdHRlbXB0ZWQpKSkgKyBnZW9tX2hsaW5lKGFlcyh5aW50ZXJjZXB0ID0gbWF4KHRvdGFsX2F0dGVtcHRlZCkpKSArIA0KICAgZmFjZXRfZ3JpZCgufkZpbGUsIHNjYWxlcyA9ICJmcmVlIikNCg0KDQpgYGANCg0KIyBRdWVzdGlvbnMgd2l0aCBnb29kIGF0dGVtcHQgY291bnQNCmBgYHtyfQ0KDQoNCnF1ZXN0aW9uX2F0dGVtcHRlZCA8LSBYICU+JSByZW1vdmVfZW1wdHkoLix3aGljaCA9ICJjb2xzIikgJT4lIA0KICBnYXRoZXIoa2V5ID0gIlF1ZXN0aW9uSUQiLCB2YWx1ZSA9ICJTY29yZXMiLCAtRmlsZSwgLVN1YmplY3RJRCkgJT4lIA0KICBncm91cF9ieShGaWxlLCBRdWVzdGlvbklEKSAlPiUNCiAgc3VtbWFyaXNlKHRvdGFsX25hID0gc3VtKGlzLm5hKFNjb3JlcykpLCB0b3RhbCA9IG4oKSwgdG90YWxfYXR0ZW1wdGVkID0gdG90YWwgLSB0b3RhbF9uYSkNCg0KcXVlc3Rpb25fYXR0ZW1wdGVkIDwtIHF1ZXN0aW9uX2F0dGVtcHRlZCAlPiUgZmlsdGVyKHRvdGFsX2F0dGVtcHRlZCA+PSA4KQ0KDQpxdWVzdGlvbl9hdHRlbXB0ZWQNCg0KIyU+JSBmaWx0ZXIoUXVlc3Rpb25JRCA9PSAiMTAzIikNCg0KYGBgDQoNCkZpbHRlcmluZyBvdXQgcXVlc3Rpb25zIHdpdGggbGVzc2VyIGF0dGVtcHRzDQoNCmBgYHtyfQ0KDQpYX2ZpbHRlcmVkIDwtIFggJT4lIHJlbW92ZV9lbXB0eSguLHdoaWNoID0gImNvbHMiKSAlPiUgDQogIGdhdGhlcihrZXkgPSAiUXVlc3Rpb25JRCIsIHZhbHVlID0gIlNjb3JlcyIsIC1GaWxlLCAtU3ViamVjdElEKSAlPiUgc2VtaV9qb2luKHF1ZXN0aW9uX2F0dGVtcHRlZCwgYnkgPSBjKCJGaWxlIiwgIlF1ZXN0aW9uSUQiKSkgJT4lIA0KICBzcHJlYWQoa2V5ID0gIlF1ZXN0aW9uSUQiLCB2YWx1ZSA9ICJTY29yZXMiKQ0KDQpYX2ZpbHRlcmVkDQpgYGANCg0KDQoNCiMgVGFrZSBhd2F5IHF1ZXN0aW9ucyBhbnN3ZXJlZCBsZXNzIHRoYXQgNSB0aW1lcyBwZXIgZXhhbQ0KYGBge3J9DQpYICU+JSByZW1vdmVfZW1wdHkoLix3aGljaCA9ICJjb2xzIikgJT4lIHdyaXRlX2NzdigiZGF0YVxcWC5jc3YiKQ0KDQpYX2ZpbHRlcmVkICU+JSByZW1vdmVfZW1wdHkoLix3aGljaCA9ICJjb2xzIikgJT4lIHdyaXRlX2NzdigiZGF0YVxcWF9maWx0ZXJlZC5jc3YiKQ0KYGBgDQoNCldyaXRlIENTVnMgc2VwZXJhdGUgZm9yIGVhY2ggdHJpYWwgdG8gYXZvaWQgaGF2aW5nIGNvbHVtbnMgZm9yIHRob3NlIHF1ZXN0aW9ucyB0aGF0IHdlcmUgbm90IGFza2VkIGluIGEgdHJpYWwuIFRoaXMgd2lsbCBoZWxwIHRvIHNob3cgdGhlIHRydWUgcGljdHVyZSBvZiBzcGFyc2l0eS4gDQoNCmBgYHtyIHBhZ2VkLnByaW50PUZBTFNFfQ0KDQpmbi5jbGVhbiA8LSBmdW5jdGlvbiAoZGYpIHsNCiAgcmV0dXJuKGRmICU+JSByZW1vdmVfZW1wdHkoLix3aGljaCA9ICJjb2xzIikpDQogIA0KfQ0KDQoNClguaW5kaXZpZHVhbC5saXN0IDwtIFggJT4lIA0KbmVzdCgtRmlsZSkgJT4lIA0KICBtdXRhdGUoZGF0YV9jbGVhbiA9IG1hcChkYXRhLCBmbi5jbGVhbikpDQoNClguaW5kaXZpZHVhbC5saXN0DQoNCg0KDQpgYGANCg0KYGBge3IgfQ0KDQpmbi53cml0ZSA8LSBmdW5jdGlvbihrZXksIGRhdGEpIHsNCiAgDQogIHByaW50KGRhdGEpDQogIGRhdGEgJT4lIHdyaXRlX2NzdihwYXN0ZTAoImRhdGFcXCIsa2V5LCIuY3N2IikpDQogIA0KfQ0KDQp3YWxrMihYLmluZGl2aWR1YWwubGlzdCRGaWxlLCBYLmluZGl2aWR1YWwubGlzdCRkYXRhX2NsZWFuLCBmbi53cml0ZSkNCg0KDQpgYGANCg0KDQpgYGB7cn0NCg0KWCAlPiUgZmlsdGVyKEZpbGUgPT0gIkV4YW0xVHJpYWwxIikgJT4lIHJlbW92ZV9lbXB0eSguLHdoaWNoID0gImNvbHMiKQ0KDQpgYGANCg0KYGBge3J9DQoNClggJT4lIGZpbHRlcihGaWxlID09ICJFeGFtMVRyaWFsMiIpICU+JSByZW1vdmVfZW1wdHkoLix3aGljaCA9ICJjb2xzIikNCg0KYGBgDQoNCmBgYHtyfQ0KDQpYICU+JSBmaWx0ZXIoRmlsZSA9PSAiRXhhbTJUcmlhbDEiKSAlPiUgcmVtb3ZlX2VtcHR5KC4sd2hpY2ggPSAiY29scyIpICU+JQ0KICBnYXRoZXIoa2V5PSJRdWVzdGlvbnMiLCB2YWx1ZSA9ICJBbnN3ZXJzIiwgLUZpbGUsIC1TdWJqZWN0SUQpICU+JSANCiAgbXV0YXRlKEFuc3dlcnMgPSBmY3RfZXhwbGljaXRfbmEoYXMuY2hhcmFjdGVyIChBbnN3ZXJzKSkpICU+JQ0KICANCiAgZ2dwbG90KCkgKyBhZXMoeCA9IFF1ZXN0aW9ucywgZmlsbCA9IEFuc3dlcnMpICsgZ2VvbV9iYXIocG9zaXRpb24gPSBwb3NpdGlvbl9kb2RnZTIoKSkgKyBmYWNldF93cmFwKEFuc3dlcnMgfi4gLCBzY2FsZXMgPSAiZnJlZSIpDQoNCmBgYA0KDQpgYGB7cn0NCg0KWCAlPiUgZmlsdGVyKEZpbGUgPT0gIkV4YW0yVHJpYWwxIikgJT4lIHJlbW92ZV9lbXB0eSguLHdoaWNoID0gImNvbHMiKSAlPiUNCiAgZ2F0aGVyKGtleT0iUXVlc3Rpb25zIiwgdmFsdWUgPSAiQW5zd2VycyIsIC1GaWxlLCAtU3ViamVjdElEKSAlPiUgDQogIG11dGF0ZShBbnN3ZXJzID0gZmN0X2V4cGxpY2l0X25hKGFzLmNoYXJhY3RlciAoQW5zd2VycykpKSAlPiUNCiAgDQogIGdncGxvdCgpICsgYWVzKHggPSBBbnN3ZXJzKSArIGdlb21fYmFyKHBvc2l0aW9uID0gcG9zaXRpb25fZG9kZ2UyKCkpICsgZmFjZXRfd3JhcChBbnN3ZXJzIH4uICwgc2NhbGVzID0gImZyZWUiKQ0KDQpgYGANCg0KDQojIE1lcmdlIHdpdGggUQ0KDQpgYGB7cn0NCg0KI1EgPC0gcmVhZF9jc3YoImRhdGFcXFEuY3N2IikNCg0KUQ0KDQpgYGANCg0KYGBge3IgIHBhZ2VkLnByaW50PUZBTFNFfQ0KDQpmbi5za2lsbHMgPC0gZnVuY3Rpb24gKGRmKSB7DQogIA0KICBkZiA8LSBkZiAlPiUgcmVtb3ZlX2VtcHR5KC4sd2hpY2ggPSAiY29scyIpICU+JQ0KICBnYXRoZXIoa2V5ID0gIlFfVU5JUVVFX0lEIiwgdmFsdWUgPSAiU2NvcmUiLCAtU3ViamVjdElEKSAlPiUNCiAgbXV0YXRlKFFfVU5JUVVFX0lEID0gYXMuaW50ZWdlcihRX1VOSVFVRV9JRCkpICU+JSBkaXN0aW5jdChRX1VOSVFVRV9JRCkgJT4lDQogIA0KICBpbm5lcl9qb2luKA0KICAgIFENCiAgICANCiAgKSAlPiUgcmVtb3ZlX2VtcHR5KC4sd2hpY2ggPSAiY29scyIpDQogIA0KICByZXR1cm4oZGYpDQogIA0KfQ0KDQoNClguUSA8LSBYLmluZGl2aWR1YWwubGlzdCAlPiUgDQogIG11dGF0ZShkYXRhX1Ffc2tpbGxzID0gbWFwKGRhdGFfY2xlYW4sIGZuLnNraWxscykpDQoNCg0KWC5RIA0KDQojWCAlPiUgZmlsdGVyKEZpbGUgPT0gIkV4YW0xVHJpYWwxIikgJT4lIHJlbW92ZV9lbXB0eSguLHdoaWNoID0gImNvbHMiKSAlPiUNCiMgIGdhdGhlcihrZXkgPSAiUV9VTklRVUVfSUQiLCB2YWx1ZSA9ICJTY29yZSIsIC1GaWxlLCAtU3ViamVjdElEKSAlPiUNCiMgIG11dGF0ZShRX1VOSVFVRV9JRCA9IGFzLmludGVnZXIoUV9VTklRVUVfSUQpKSAlPiUgZGlzdGluY3QoUV9VTklRVUVfSUQpICU+JQ0KIyAgDQojICBpbm5lcl9qb2luKA0KIyAgICBRDQojICAgIA0KIyAgKSAlPiUgcmVtb3ZlX2VtcHR5KC4sd2hpY2ggPSAiY29scyIpDQoNCg0KYGBgDQoNCg0KDQoNCg0K